MODULE contraction
  !---------------------------------------------------------------------
  ! Contraction patterns
  !---------------------------------------------------------------------
  ! Copyright (C) 2003-2008 Pekka Manninen, 2010 Jussi Lehtola                                                                                                                                                  !                                                                               
  ! This program is distributed under the terms of the GNU General
  ! Public License as published by the Free Software Foundation;
  ! either version 2 of the License, or (at your option) any later version.
  !
  ! This program is distributed in the hope that it will be useful,
  ! but WITHOUT ANY WARRANTY; without even the implied warranty of
  ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. In addition, the 
  ! author must be properly cited whenever the program or some parts 
  ! originated on it are used. 
  !
  ! Please note, that the author must be properly cited whenever 
  ! this program or some parts originated on it are employed. 
  !
  !---------------------------------------------------------------------
  USE definitions
  USE textutil
  IMPLICIT NONE

CONTAINS

  !---------------------------------------------------------------------
  ! contraction pattern generators
  !---------------------------------------------------------------------
  SUBROUTINE karls_select(charge,ntuple,polar,patt)
    ! Karlsruhe-type contraction
    IMPLICIT NONE
    CHARACTER(LEN=3), INTENT(IN) :: ntuple, polar
    INTEGER, INTENT(IN) :: charge
    INTEGER, INTENT(OUT), DIMENSION(6) :: patt

    patt = 0
    SELECT CASE (str_lo_to_up(ntuple))
    CASE('D')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 2
       ELSE IF(charge == 3 .OR. charge == 4) THEN
          patt(1) = 3
       ELSE IF(charge >= 5 .AND. charge <= 10) THEN
          patt(1) = 3
          patt(2) = 2
       ELSE IF(charge >= 11 .AND. charge <= 12) THEN
          patt(1) = 4
          patt(2) = 1
       ELSE IF(charge >= 13 .AND. charge <= 18) THEN
          patt(1) = 4
          patt(2) = 3
       ELSE IF(charge >= 19 .AND. charge <= 20) THEN
          patt(1) = 5
          patt(2) = 2
       ELSE IF(charge >= 21 .AND. charge <= 30) THEN
          patt(1) = 5
          patt(2) = 2
          patt(3) = 2
       ELSE IF(charge >= 31 .AND. charge <= 36) THEN
          patt(1) = 5
          patt(2) = 4
          patt(3) = 2
       ELSE
          WRITE(*,*) 'Elements beyond Kr not supported yet...'
       END IF
    CASE('T')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 3
       ELSE IF(charge == 3 .OR. charge == 4) THEN
          patt(1) = 6
       ELSE IF(charge >= 5 .AND. charge <= 10) THEN
          patt(1) = 6
          patt(2) = 3
       ELSE IF(charge >= 11 .AND. charge <= 12) THEN
          patt(1) = 7
          patt(2) = 2
       ELSE IF(charge >= 13 .AND. charge <= 18) THEN
          patt(1) = 7
          patt(2) = 5
       ELSE IF(charge >= 19 .AND. charge <= 20) THEN
          patt(1) = 8
          patt(2) = 5
       ELSE IF(charge >= 21 .AND. charge <= 30) THEN
          patt(1) = 8
          patt(2) = 5
          patt(3) = 3
       ELSE IF(charge >= 31 .AND. charge <= 36) THEN
          patt(1) = 8
          patt(2) = 6
          patt(3) = 3
       ELSE
          WRITE(*,*) 'Elements beyond Kr not supported yet...'
       END IF
    CASE('Q')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 4
       ELSE IF(charge == 3 .OR. charge == 4) THEN
          patt(1) = 4
          patt(2) = 1
       ELSE IF(charge >= 5 .AND. charge <= 10) THEN
          patt(1) = 7
          patt(2) = 4
       ELSE IF(charge >= 11 .AND. charge <= 12) THEN
          patt(1) = 9
          patt(2) = 5
       ELSE IF(charge >= 13 .AND. charge <= 18) THEN
          patt(1) = 9
          patt(2) = 6
       ELSE IF(charge >= 19 .AND. charge <= 20) THEN
          patt(1) = 11
          patt(2) = 6
       ELSE IF(charge >= 21 .AND. charge <= 30) THEN
          patt(1) = 11
          patt(2) = 6
          patt(3) = 5
       ELSE IF(charge >= 31 .AND. charge <= 36) THEN
          patt(1) = 11
          patt(2) = 7
          patt(3) = 4
       ELSE
          WRITE(*,*) 'Elements beyond Kr not supported yet...'
       END IF
    END SELECT

    SELECT CASE(str_lo_to_up(polar))
    CASE('P')
       IF(charge >= 1 .AND. charge <= 4) THEN
          patt(2) = patt(2) + 1
       ELSE IF(charge >= 5 .AND. charge <= 20) THEN
          patt(3) = patt(3) + 1
       ELSE IF(charge >= 21 .AND. charge <= 36) THEN
          patt(4) = patt(4) + 1
       END IF
    CASE('2P')
       IF(charge >= 1 .AND. charge <= 4) THEN
          patt(2) = patt(2) + 2
          patt(3) = patt(3) + 1
       ELSE IF(charge >= 5 .AND. charge <= 20) THEN
          patt(3) = patt(3) + 2
          patt(4) = patt(4) + 1
       ELSE IF(charge >= 21 .AND. charge <= 36) THEN
          patt(4) = patt(4) + 2
          patt(5) = patt(5) + 1
       END IF
    CASE('3P')
       IF(charge >= 1 .AND. charge <= 10) THEN
          patt(2) = patt(2) + 3
          patt(3) = patt(3) + 2
          patt(4) = patt(4) + 1
       ELSE IF(charge >= 13 .AND. charge <= 18) THEN
          patt(2) = patt(2) + 3
          patt(3) = patt(3) + 2
          patt(4) = patt(4) + 1
       ELSE IF(charge >= 11 .AND. charge <= 12) THEN
          patt(3) = patt(3) + 4
          patt(4) = patt(4) + 1
       ELSE IF(charge >= 19 .AND. charge <= 20) THEN
          patt(3) = patt(3) + 4
          patt(4) = patt(4) + 1
       ELSE IF(charge >= 21 .AND. charge <= 36) THEN
          patt(4) = patt(4) + 3
          patt(5) = patt(5) + 1
       END IF
    END SELECT
    RETURN
  END SUBROUTINE karls_select

  SUBROUTINE cc_select(charge,ntuple,patt)
    ! Correlation consistent -type contraction
    IMPLICIT NONE
    CHARACTER(LEN=1), INTENT(IN) :: ntuple
    INTEGER, INTENT(IN) :: charge
    INTEGER, INTENT(OUT), DIMENSION(7) :: patt

    patt = 0
    SELECT CASE (str_lo_to_up(ntuple))
    CASE('D')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 2
          patt(2) = 1
       ELSE IF(charge >= 3 .AND. charge <= 10) THEN
          patt(1) = 3
          patt(2) = 2
          patt(3) = 1
       ELSE IF(charge >= 11 .AND. charge <= 18) THEN
          patt(1) = 4
          patt(2) = 3
          patt(3) = 1
       ELSE IF(charge >= 19 .AND. charge <= 36) THEN
          patt(1) = 5
          patt(2) = 4
          patt(3) = 2
          patt(4) = 1
       ELSE IF(charge >= 37 .AND. charge <= 54) THEN
          patt(1) = 6
          patt(2) = 5
          patt(3) = 3
          patt(4) = 2
          patt(5) = 1
       ELSE IF(charge >= 55 .AND. charge <= 86) THEN
          patt(1) = 7
          patt(2) = 6
          patt(3) = 5
          patt(4) = 2
          patt(5) = 1
       ELSE IF(charge >= 87 .AND. charge <= 118) THEN
          patt(1) = 9
          patt(2) = 8
          patt(3) = 7
          patt(4) = 4
          patt(5) = 2
          patt(6) = 1
       ELSE
          WRITE(*,*) 'No such element exists...'
       END IF
    CASE('t', 'T')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 3
          patt(2) = 2
          patt(3) = 1
       ELSE IF(charge >= 3 .AND. charge <= 10) THEN
          patt(1) = 4
          patt(2) = 3
          patt(3) = 2
          patt(4) = 1
       ELSE IF(charge >= 11 .AND. charge <= 18) THEN
          patt(1) = 5
          patt(2) = 4
          patt(3) = 2
          patt(4) = 1
       ELSE
          WRITE(*,'(A)') 'Sorry, element is not available for this basis set' 
       END IF
    CASE('q', 'Q')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 4
          patt(2) = 3
          patt(3) = 2
          patt(4) = 1
       ELSE IF(charge >= 3 .AND. charge <= 10) THEN
          patt(1) = 5
          patt(2) = 4
          patt(3) = 3
          patt(4) = 2
          patt(5) = 1
       ELSE IF(charge >= 11 .AND. charge <= 18) THEN
          patt(1) = 6
          patt(2) = 5
          patt(3) = 3
          patt(4) = 2
          patt(5) = 1
       ELSE
          WRITE(*,'(A)') 'Sorry, element is not available for this basis set' 
       END IF
    CASE('5')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 5
          patt(2) = 4
          patt(3) = 3
          patt(4) = 2
          patt(1) = 1
       ELSE IF(charge >= 3 .AND. charge <= 10) THEN
          patt(1) = 6
          patt(2) = 5
          patt(3) = 4
          patt(4) = 3
          patt(5) = 2
          patt(6) = 1
       ELSE IF(charge >= 11 .AND. charge <= 18) THEN
          patt(1) = 7
          patt(2) = 6
          patt(3) = 4
          patt(4) = 3
          patt(5) = 2
          patt(6) = 1
       ELSE
          WRITE(*,'(A)') 'Sorry, element is not available for this basis set' 
       END IF
    CASE('6')
       IF(charge == 1 .OR. charge == 2) THEN
          patt(1) = 6
          patt(2) = 5
          patt(3) = 4
          patt(4) = 3
          patt(5) = 2
          patt(6) = 1
       ELSE IF(charge >= 3 .AND. charge <= 10) THEN
          patt(1) = 7
          patt(2) = 6
          patt(3) = 5
          patt(4) = 4
          patt(5) = 3
          patt(6) = 2
          patt(7) = 1
       ELSE IF(charge >= 11 .AND. charge <= 18) THEN
          patt(1) = 8
          patt(2) = 7
          patt(3) = 6
          patt(4) = 5
          patt(5) = 3
          patt(6) = 2
          patt(7) = 1
       ELSE
          WRITE(*,'(A)') 'Sorry, element is not available for this basis set' 
       END IF
    END SELECT
    RETURN
  END SUBROUTINE cc_select

END MODULE contraction
